perm filename KSIG.FAI[XX,LCS]1 blob
sn#208659 filedate 1976-03-29 generic text, type T, neo UTF8
00100 TITLE KSIG ; 00100 SUBROUTINE KSIG
00200 ENTRY KSIG
00300 EXTERNAL .COMM.,STF,CENTX,NOTWRT,IFIX
00400 KSIG: 0 ; FOR KEY SIGNATURES AND ACCENTS, ETC. (IN 'SCORE')
00500 ;00300 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(17),T,Z,H/STF/RSTFAC(-3/4),RSTJ2
00600 ;00400 C*******************;;;; Z WIPED OUT IN NOTWRT!!! BE CAREFUL WITH S!!!
00700 ;00500 EQUIVALENCE (R4,RJQ(2)),(J4,JQ(2)),(J5,JQ(3)),(J6,JQ(4))
00800 ;00600 1,(R6,RJQ(4))
01000 MOVEI 02,11 ; JA=9
01100 MOVEM 2,.COMM.+1 ; C USES THIS KEY NUM IN NOTWRT
01300 ; COUNTER -- IZ=IABS(J5)
01400 MOVM 15,.COMM.+=26 ; NUMBER OF CALLS ON NOTWRT
01600 ; 01300 C THE CLEF NUM. IT GETS WIPED OUT IN NOTWRT.
01700 ; 01400 JW=1
01800 MOVEI 2,1
02000 ; 01500 R6=0
02100 SETZM .COMM.+7
02200 ; 01600 IF(J5.GT.0)JW=2
02300 SKIPLE .COMM.+=26
02400 AOS 2 ; 01700 C THE CODE FOR FLAT OR SHARP
02500 CAIGE 15,144 ; 01800 IF(IZ.LT.100)GO TO 5333
02600 JRST KS1
02700 MOVEI 2,3 ; 01900 JW=3
02900 SUBI 15,144 ; 02000 IZ=IZ-100
03000 ; 2100 WILL MAKE NATURALS IF 100 IS ADDED OR SUBTRACTED.
03110 KS1: MOVEM 2,JW# ; 02200 5333 CLEF=J6+1
03200 MOVE 4,.COMM.+=27
03300 MOVEM 4,CLEF#
03600 ;CLEF #S ARE 0,1,2,3 (TREB.,BA.,ALT.,TEN.)
03700 ; 02400 C CLEF NOW SET IN MAIN PROG.
03800 ; 02500 C IF NO CLEF GIVEN, TREBLE IS USED.
03900 ; 02600 T=10.
04000 MOVSI 13,204500 ; 13 IS T
04100 CAILE 4,1 ;2700 IF(CLEF.GT.1.)T=11.
04300 MOVSI 13,204540
04310 MOVEM 13,T#
04400 CAIN 4,3
04410 JRST KSX
04500 MOVNI 2,(4) ; 02800 S=3-CLEF
04510 ADDI 2,3
04520 SKIPA
04700 KSX: SETO 2, ; 02900 IF(CLEF.EQ.3)S=-1.
04800 TLC 2,232000
04900 FADR 2,2
04950 MOVEM 2,S#
05000 ; 03000 IF(J5.LT.0)GO TO 253
05100 MOVE 02,.COMM.+=26
05200 JUMPL 02,KS2
05300 ; 03100 W=-3.
05400 MOVN 02,[3.0]
05500 ; 03200 YY=4.
05600 MOVSI 3,203400
05700 ; 03300 Z=11.
05800 MOVSI 4,204540 ; 03400 C SHARPS
05900 ; 03500 GO TO 353
06000 JRST KS3
06100 ; 03600 253 W=-4
06200 KS2: MOVN 2,[4.0]
06300 ; 03700 YY=3.
06400 MOVSI 3,202600
06500 ; 03800 Z=7.
06600 MOVSI 4,203700 ; 03900 C FLATS
06700 KS3: MOVEM 2,W# ; 04000 353 N=-1
06800 MOVEM 3,YY#
06900 SETOM N#
07200 FADR 4,.COMM.+5 ;4100 Z=Z+R4
07300 MOVE .COMM.+4 ;RX=R3
07400 MOVEM RX#
08000 ; 04300 RA=0
08100 SETZM RA#
08200 ; 04400 C RA IS AMOUNT TO BE ADDED TO ORIGINAL POS.
08210 MOVSI 204640
08220 FMPR STF+=8
08230 MOVEM .COMM.+=27 ; SAVES IT IN J6
08300 MOVEM 15,IZ# ; 04500 DO 553 KA=1,IZ
08400 MOVEI 15,1
08500 ; 04600 J5=JW
08600 KS6: MOVE 02,JW
08700 MOVEM 02,.COMM.+=26
08800 ; 04700 R3=RX+RA
08900 MOVE 02,RX
09000 FADR 02,RA
09100 MOVEM 02,.COMM.+4
09200 ; 04800 RA=RA+13.*RSTJ2
09300 MOVE 02,.COMM.+=27
09500 FADRM 02,RA ; 04900 C MOVES OVER FOR NEXT ACCI.
09600 ; 05000 RD=Z
09800 MOVEM 4,RD#
09900 ; 05100 R4=Z
10000 MOVEM 4,.COMM.+5
10100 SKIPE CLEF ; 05200 IF(CLEF.NE.0)GO TO 7
10400 JRST KS7
10500 CAMG 4,[12.0] ;5300 IF(R4.GT.12.)R4=R4-7.
10800 JRST KS9
10900 MOVN 02,[7.0]
11000 FADRM 02,.COMM.+5
11100 ; 05400 GO TO 9
11200 JRST KS9
11300 ; 05500 7 R4=R4-S
11400 KS7: MOVN 02,S
11500 FADRB 02,.COMM.+5
11600 CAMG 2,T ; 05600 IF(R4.GT.T)R4=R4-7.
11700 JRST KS9
11800 MOVN 02,[7.0]
11900 FADRM 02,.COMM.+5 ;5700 ABOVE ARRANGES VERT. POS OF ACCIS.
12000 ; 05800 9 J4=R4
12100 KS9: JSA 16,IFIX
12200 JUMP .COMM.+5
12300 MOVEM 00,.COMM.+=25
12400 ; 05900 C FOR VERT. POS. IN 'DRWNT' (WHEN PLOTTING.)
12600 JSA 16,CENTX
12800 JSA 16,NOTWRT
12900 ; 06200 Z=RD+W
13000 MOVE 4,W
13300 SKIPG N ; 06300 IF(N.GT.0)Z=RD+YY
13600 MOVE 4,YY ; N WAS -1 1ST TIME.
13700 FADR 4,RD
13900 ; 06400 553 N=-N
14000 MOVNS 00,N
14100 CAMGE 15,IZ
14200 AOJA 15,KS6
14300 JRA 16,(16) ; 06500 END
14400 END